C
C  Revised Token stream access functions - version 2.
C
C  GENERAL
C  ------
C
C  ZTOKTX  Return the expanded text of a token, i.e. the string
C          that it actually represents
C  ZTOKNM  Return a string containing the name of a token.
C
C
C  INPUT
C  -----
C
C  ZTKGTI  Initialise input from a given source.
C  ZTKGTQ  Terminate input from a given source.
C  ZSCAN   Dummy routine.
C  ZGETTK  Get the next token from the specified file.
C
C
C  OUTPUT
C  ------
C
C  ZTKPTI  Initialise output to a given source.
C  ZTKPTQ  Terminate output to a given source.
C  ZUSCAN  Dummy routine.
C  ZPUTTK  Put the next token to the specified files.
C  PLOPTF  Dummy routine.
C  POLOPT  Dummy routine.
C
C  LOW LEVEL ROUTINES
C  ------------------
C
C  XTKADD  Add a character to an internal buffer, flush to
C          a file if full.
C  XTKSUB  Get a character from an internal buffer, refill
C          from a file if empty.
C
C----------------------------------------------------------
C
C       Z T O K T X  -  Convert token from stream into text
C
C       STATUS : INTEGER (result) -- err/ok
C       TYPE   : INTEGER    Type of token from ZTREAD/ZTOKRD
C       LENGTH : INTEGER    Length of associated text string
C       STRING : INTEGER(*) Associated text string
C       TEXT   : INTEGER(*) Resultant text
C
        INTEGER FUNCTION ZTOKTX(TYPE,LENGTH,STRING,TEXT)
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.1
C---------------------------------------------------------
C
C  TKLAST = LAST TOKEN NUMBER
C
      INTEGER TZEOF ,TASSIG,TBACKS,TBLOCK,TCALL ,TCLOSE,TCOMMO,TCONTI,
     +        TDATA ,TDO   ,TDIMEN,TELSE ,TELSIF,TEND  ,TENDFI,TENDIF,
     +        TENTRY,TEQUIV,TEXTER,TFUNCT,TFORMA,TGOTO ,TIF   ,TIMPLI,
     +        TINQUI,TINTRI,TOPEN ,TPARAM,TPAUSE,TPRINT,TPROGR,TREAD ,
     +        TRETUR,TREWIN,TSAVE ,TSTOP ,TSUBRO,TTHEN ,TTO   ,TWRITE,
     +        TINTEG,TREAL ,TDOUBL,TCOMPL,TLOGIC,TCHARA,TDCMPL,TCOMMA,
     +        TEQUAL,TCOLON,TLPARN,TRPARN,TLE   ,TLT   ,TEQ   ,TNE   ,
     +        TGE   ,TGT   ,TAND  ,TOR   ,TEQV  ,TNEQV ,TNOT  ,TSTAR ,
     +        TDSTAR,TPLUS ,TMINUS,TSLASH,TCNCAT,TDCNST,TLCNST,TRCNST,
     +        TPCNST,TCCNST,THCNST,TNAME ,TFIELD,TSCALE,TZEOS ,TCMMNT,
     +        TFMTKD,TENDKD,TERRKD,TKLAST
      PARAMETER (TZEOF = 1,TASSIG= 2,TBACKS= 3,TBLOCK= 4,TCALL = 5,
     +           TCLOSE= 6,TCOMMO= 7,TCONTI= 8,TDATA = 9,TDO   =10,
     +           TDIMEN=11,TELSE =12,TELSIF=13,TEND  =14,TENDFI=15,
     +           TENDIF=16,TENTRY=17,TEQUIV=18,TEXTER=19,TFUNCT=20,
     +           TFORMA=21,TGOTO =22,TIF   =23,TIMPLI=24,TINQUI=25,
     +           TINTRI=26,TOPEN =27,TPARAM=28,TPAUSE=29,TPRINT=30,
     +           TPROGR=31,TREAD =32,TRETUR=33,TREWIN=34,TSAVE =35,
     +           TSTOP =36,TSUBRO=37,TTHEN =38,TTO   =39,TWRITE=40,
     +           TINTEG=41,TREAL =42,TDOUBL=43,TCOMPL=44,TLOGIC=45,
     +           TCHARA=46,TDCMPL=47,TCOMMA=48,TEQUAL=49,TCOLON=50,
     +           TLPARN=51,TRPARN=52,TLE   =53,TLT   =54,TEQ   =55,
     +           TNE   =56,TGE   =57,TGT   =58,TAND  =59,TOR   =60,
     +           TEQV  =61,TNEQV =62,TNOT  =63,TSTAR =64,TDSTAR=65,
     +           TPLUS =66,TMINUS=67,TSLASH=68,TCNCAT=69,TDCNST=70,
     +           TLCNST=71,TRCNST=72,TPCNST=73,TCCNST=74,THCNST=75,
     +           TNAME =76,TFIELD=77,TSCALE=78,TZEOS =79,TCMMNT=80,
     +           TFMTKD=81,TENDKD=82,TERRKD=83,TKLAST=83)
 
        INTEGER TYPE,LENGTH,STRING(*),TEXT(*)
        INTEGER TOKTXT(488),INDEX(TKLAST),I,J
        SAVE
 
        INTEGER ITOC
        EXTERNAL ITOC
 
        DATA (TOKTXT(I),I=1,74)/60,101,111,102,62,129,
     +      65,83,83,73,71,78,32,129,
     +      66,65,67,75,83,80,65,67,69,32,129,
     +      66,76,79,67,75,32,68,65,84,65,32,129,
     +      67,65,76,76,32,129,
     +      67,76,79,83,69,32,129,
     +      67,79,77,77,79,78,32,129,
     +      67,79,78,84,73,78,85,69,32,129,
     +      68,65,84,65,32,129/
        DATA(TOKTXT(I),I=75,152)/68,79,32,129,
     +      68,73,77,69,78,83,73,79,78,32,129,
     +      69,76,83,69,129,
     +      69,76,83,69,32,73,70,129,
     +      69,78,68,129,
     +      69,78,68,70,73,76,69,32,129,
     +      69,78,68,32,73,70,129,
     +      69,78,84,82,89,32,129,
     +      69,81,85,73,86,65,76,69,78,67,69,
     +32,129,
     +      69,88,84,69,82,78,65,76,32,129/
        DATA(TOKTXT(I),I=153,217)/
     +      70,85,78,67,84,73,79,78,32,129,
     +      70,79,82,77,65,84,32,129,
     +      71,79,32,84,79,32,129,
     +      73,70,32,129,
     +      73,77,80,76,73,67,73,84,32,129,
     +      73,78,81,85,73,82,69,32,129,
     +      73,78,84,82,73,78,83,73,67,32,129,
     +      79,80,69,78,32,129/
        DATA(TOKTXT(I),I=218,279)/
     +      80,65,82,65,77,69,84,69,82,32,129,
     +      80,65,85,83,69,32,129,
     +      80,82,73,78,84,32,129,
     +      80,82,79,71,82,65,77,32,129,
     +      82,69,65,68,32,129,
     +      82,69,84,85,82,78,32,129,
     +      82,69,87,73,78,68,32,129,
     +      83,65,86,69,32,129/
        DATA(TOKTXT(I),I=280,347)/83,84,79,80,32,129,
     +      83,85,66,82,79,85,84,73,78,69,32,129,
     +      84,72,69,78,32,129,
     +      84,79,32,129,
     +      87,82,73,84,69,32,129,
     +      73,78,84,69,71,69,82,32,129,
     +      82,69,65,76,32,129,
     +      68,79,85,66,76,69,32,80,82,69,67,
     +73,83,73,79,78,32,129/
        DATA(TOKTXT(I),I=348,406)/
     +      67,79,77,80,76,69,88,32,129,
     +      76,79,71,73,67,65,76,32,129,
     +      67,72,65,82,65,67,84,69,82,32,129,
     +      44,129,61,129,58,129,40,129,41,129,
     +      46,76,69,46,129,
     +      46,76,84,46,129,
     +      46,69,81,46,129,
     +      46,78,69,46,129/
        DATA(TOKTXT(I),I=407,460)/46,71,69,46,129,
     +      46,71,84,46,129,
     +      46,65,78,68,46,129,
     +      46,79,82,46,129,
     +      46,69,81,86,46,129,
     +      46,78,69,81,86,46,129,
     +      46,78,79,84,46,129,
     +      42,129,42,42,129,43,129,45,129,
     +      47,129,47,47,129/
        DATA(TOKTXT(I),I=461,473)/129,
     +      70,77,84,129,
     +      69,78,68,129,
     +      69,82,82,129/
        DATA(TOKTXT(I),I=474,488)/68,79,85,66,76,69,32,
     +      67,79,77,80,76,69,88,129/
 
        DATA INDEX/1,7,15,26,38,44,51,59,69,75,79,90,95,103,107,116,123,
     +130,143,153,163,171,178,182,192,201,212,218,229,236,243,252,258,
     +266,274,280,286,298,304,308,315,324,330,348,357,366,474,377,379,
     +381,383,385,387,392,397,402,407,412,417,423,428,434,441,447,449,
     +452,454,456,458,461,461,461,461,461,461,461,461,461,461,461,462,
     +466,470/
 
        IF (TYPE.EQ.TCCNST) THEN
            J=2
            TEXT(1)=39
            DO 200 I=1,LENGTH
                TEXT(J)=STRING(I)
                J=J+1
                IF (STRING(I).EQ.39) THEN
                    TEXT(J)=39
                    J=J+1
                END IF
 200        CONTINUE
            TEXT(J)=39
            TEXT(J+1)=129
        ELSE IF (TYPE.EQ.THCNST) THEN
            I=ITOC(LENGTH,TEXT,12)+1
            TEXT(I)=72
            DO 400 J=1,LENGTH
 400            TEXT(J+I)=STRING(J)
            TEXT(I+LENGTH+1)=129
        ELSE IF (LENGTH.GT.0) THEN
            DO 100 I=1,LENGTH
 100            TEXT(I)=STRING(I)
            TEXT(LENGTH+1)=129
        ELSE
            I=1
 300        TEXT(I)=TOKTXT(I+INDEX(TYPE)-1)
            I=I+1
            IF (TEXT(I-1).NE.129) GOTO 300
        END IF
        ZTOKTX=-2
 
        END
C-------------------------------------------------
C
C       Z T O K N M  -  Return the name of a token
C
C       STATUS : INTEGER (result) -- err/ok
C       TYPE   : INTEGER    Type of token (numeric value)
C       TEXT   : INTEGER(*) Resultant text
C
        INTEGER FUNCTION ZTOKNM(TYPE, TEXT)
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.1
C---------------------------------------------------------
C
C  TKLAST = LAST TOKEN NUMBER
C
      INTEGER TZEOF ,TASSIG,TBACKS,TBLOCK,TCALL ,TCLOSE,TCOMMO,TCONTI,
     +        TDATA ,TDO   ,TDIMEN,TELSE ,TELSIF,TEND  ,TENDFI,TENDIF,
     +        TENTRY,TEQUIV,TEXTER,TFUNCT,TFORMA,TGOTO ,TIF   ,TIMPLI,
     +        TINQUI,TINTRI,TOPEN ,TPARAM,TPAUSE,TPRINT,TPROGR,TREAD ,
     +        TRETUR,TREWIN,TSAVE ,TSTOP ,TSUBRO,TTHEN ,TTO   ,TWRITE,
     +        TINTEG,TREAL ,TDOUBL,TCOMPL,TLOGIC,TCHARA,TDCMPL,TCOMMA,
     +        TEQUAL,TCOLON,TLPARN,TRPARN,TLE   ,TLT   ,TEQ   ,TNE   ,
     +        TGE   ,TGT   ,TAND  ,TOR   ,TEQV  ,TNEQV ,TNOT  ,TSTAR ,
     +        TDSTAR,TPLUS ,TMINUS,TSLASH,TCNCAT,TDCNST,TLCNST,TRCNST,
     +        TPCNST,TCCNST,THCNST,TNAME ,TFIELD,TSCALE,TZEOS ,TCMMNT,
     +        TFMTKD,TENDKD,TERRKD,TKLAST
      PARAMETER (TZEOF = 1,TASSIG= 2,TBACKS= 3,TBLOCK= 4,TCALL = 5,
     +           TCLOSE= 6,TCOMMO= 7,TCONTI= 8,TDATA = 9,TDO   =10,
     +           TDIMEN=11,TELSE =12,TELSIF=13,TEND  =14,TENDFI=15,
     +           TENDIF=16,TENTRY=17,TEQUIV=18,TEXTER=19,TFUNCT=20,
     +           TFORMA=21,TGOTO =22,TIF   =23,TIMPLI=24,TINQUI=25,
     +           TINTRI=26,TOPEN =27,TPARAM=28,TPAUSE=29,TPRINT=30,
     +           TPROGR=31,TREAD =32,TRETUR=33,TREWIN=34,TSAVE =35,
     +           TSTOP =36,TSUBRO=37,TTHEN =38,TTO   =39,TWRITE=40,
     +           TINTEG=41,TREAL =42,TDOUBL=43,TCOMPL=44,TLOGIC=45,
     +           TCHARA=46,TDCMPL=47,TCOMMA=48,TEQUAL=49,TCOLON=50,
     +           TLPARN=51,TRPARN=52,TLE   =53,TLT   =54,TEQ   =55,
     +           TNE   =56,TGE   =57,TGT   =58,TAND  =59,TOR   =60,
     +           TEQV  =61,TNEQV =62,TNOT  =63,TSTAR =64,TDSTAR=65,
     +           TPLUS =66,TMINUS=67,TSLASH=68,TCNCAT=69,TDCNST=70,
     +           TLCNST=71,TRCNST=72,TPCNST=73,TCCNST=74,THCNST=75,
     +           TNAME =76,TFIELD=77,TSCALE=78,TZEOS =79,TCMMNT=80,
     +           TFMTKD=81,TENDKD=82,TERRKD=83,TKLAST=83)
 
        INTEGER TYPE
        INTEGER TEXT(*), TXT(7, TKLAST)
        SAVE
 
        DATA (TXT(I,TZEOF),I=1,7)/84,90,69,79,70,32,129/
        DATA (TXT(I,TASSIG),I=1,7)/84,65,83,83,73,71,129/
        DATA (TXT(I,TBACKS),I=1,7)/84,66,65,67,75,83,129/
        DATA (TXT(I,TBLOCK),I=1,7)/84,66,76,79,67,75,129/
        DATA (TXT(I,TCALL),I=1,7)/84,67,65,76,76,32,129/
        DATA (TXT(I,TCLOSE),I=1,7)/84,67,76,79,83,69,129/
        DATA (TXT(I,TCOMMO),I=1,7)/84,67,79,77,77,79,129/
        DATA (TXT(I,TCONTI),I=1,7)/84,67,79,78,84,73,129/
        DATA (TXT(I,TDATA),I=1,7)/84,68,65,84,65,32,129/
        DATA (TXT(I,TDO),I=1,7)/84,68,79,32,32,32,129/
        DATA (TXT(I,TDIMEN),I=1,7)/84,68,73,77,69,78,129/
        DATA (TXT(I,TELSE),I=1,7)/84,69,76,83,69,32,129/
        DATA (TXT(I,TELSIF),I=1,7)/84,69,76,83,73,70,129/
        DATA (TXT(I,TEND),I=1,7)/84,69,78,68,32,32,129/
        DATA (TXT(I,TENDFI),I=1,7)/84,69,78,68,70,73,129/
        DATA (TXT(I,TENDIF),I=1,7)/84,69,78,68,73,70,129/
        DATA (TXT(I,TENTRY),I=1,7)/84,69,78,84,82,89,129/
        DATA (TXT(I,TEQUIV),I=1,7)/84,69,81,85,73,86,129/
        DATA (TXT(I,TEXTER),I=1,7)/84,69,88,84,69,82,129/
        DATA (TXT(I,TFUNCT),I=1,7)/84,70,85,78,67,84,129/
        DATA (TXT(I,TFORMA),I=1,7)/84,70,79,82,77,65,129/
        DATA (TXT(I,TGOTO),I=1,7)/84,71,79,84,79,32,129/
        DATA (TXT(I,TIF),I=1,7)/84,73,70,32,32,32,129/
        DATA (TXT(I,TIMPLI),I=1,7)/84,73,77,80,76,73,129/
        DATA (TXT(I,TINQUI),I=1,7)/84,73,78,81,85,73,129/
        DATA (TXT(I,TINTRI),I=1,7)/84,73,78,84,82,73,129/
        DATA (TXT(I,TOPEN),I=1,7)/84,79,80,69,78,32,129/
        DATA (TXT(I,TPARAM),I=1,7)/84,80,65,82,65,77,129/
        DATA (TXT(I,TPAUSE),I=1,7)/84,80,65,85,83,69,129/
        DATA (TXT(I,TPRINT),I=1,7)/84,80,82,73,78,84,129/
        DATA (TXT(I,TPROGR),I=1,7)/84,80,82,79,71,82,129/
        DATA (TXT(I,TREAD),I=1,7)/84,82,69,65,68,32,129/
        DATA (TXT(I,TRETUR),I=1,7)/84,82,69,84,85,82,129/
        DATA (TXT(I,TREWIN),I=1,7)/84,82,69,87,73,78,129/
        DATA (TXT(I,TSAVE),I=1,7)/84,83,65,86,69,32,129/
        DATA (TXT(I,TSTOP),I=1,7)/84,83,84,79,80,32,129/
        DATA (TXT(I,TSUBRO),I=1,7)/84,83,85,66,82,79,129/
        DATA (TXT(I,TTHEN),I=1,7)/84,84,72,69,78,32,129/
        DATA (TXT(I,TTO),I=1,7)/84,84,79,32,32,32,129/
        DATA (TXT(I,TWRITE),I=1,7)/84,87,82,73,84,69,129/
        DATA (TXT(I,TINTEG),I=1,7)/84,73,78,84,69,71,129/
        DATA (TXT(I,TREAL),I=1,7)/84,82,69,65,76,32,129/
        DATA (TXT(I,TDOUBL),I=1,7)/84,68,79,85,66,76,129/
        DATA (TXT(I,TCOMPL),I=1,7)/84,67,79,77,80,76,129/
        DATA (TXT(I,TLOGIC),I=1,7)/84,76,79,71,73,67,129/
        DATA (TXT(I,TCHARA),I=1,7)/84,67,72,65,82,65,129/
        DATA (TXT(I,TDCMPL),I=1,7)/84,68,67,77,80,76,129/
        DATA (TXT(I,TCOMMA),I=1,7)/84,67,79,77,77,65,129/
        DATA (TXT(I,TEQUAL),I=1,7)/84,69,81,85,65,76,129/
        DATA (TXT(I,TCOLON),I=1,7)/84,67,79,76,79,78,129/
        DATA (TXT(I,TLPARN),I=1,7)/84,76,80,65,82,78,129/
        DATA (TXT(I,TRPARN),I=1,7)/84,82,80,65,82,78,129/
        DATA (TXT(I,TLE),I=1,7)/84,76,69,32,32,32,129/
        DATA (TXT(I,TLT),I=1,7)/84,76,84,32,32,32,129/
        DATA (TXT(I,TEQ),I=1,7)/84,69,81,32,32,32,129/
        DATA (TXT(I,TNE),I=1,7)/84,78,69,32,32,32,129/
        DATA (TXT(I,TGE),I=1,7)/84,71,69,32,32,32,129/
        DATA (TXT(I,TGT),I=1,7)/84,71,84,32,32,32,129/
        DATA (TXT(I,TAND),I=1,7)/84,65,78,68,32,32,129/
        DATA (TXT(I,TOR),I=1,7)/84,79,82,32,32,32,129/
        DATA (TXT(I,TEQV),I=1,7)/84,69,81,86,32,32,129/
        DATA (TXT(I,TNEQV),I=1,7)/84,78,69,81,86,32,129/
        DATA (TXT(I,TNOT),I=1,7)/84,78,79,84,32,32,129/
        DATA (TXT(I,TSTAR),I=1,7)/84,83,84,65,82,32,129/
        DATA (TXT(I,TDSTAR),I=1,7)/84,68,83,84,65,82,129/
        DATA (TXT(I,TPLUS),I=1,7)/84,80,76,85,83,32,129/
        DATA (TXT(I,TMINUS),I=1,7)/84,77,73,78,85,83,129/
        DATA (TXT(I,TSLASH),I=1,7)/84,83,76,65,83,72,129/
        DATA (TXT(I,TCNCAT),I=1,7)/84,67,78,67,65,84,129/
        DATA (TXT(I,TDCNST),I=1,7)/84,68,67,78,83,84,129/
        DATA (TXT(I,TLCNST),I=1,7)/84,76,67,78,83,84,129/
        DATA (TXT(I,TRCNST),I=1,7)/84,82,67,78,83,84,129/
        DATA (TXT(I,TPCNST),I=1,7)/84,80,67,78,83,84,129/
        DATA (TXT(I,TCCNST),I=1,7)/84,67,67,78,83,84,129/
        DATA (TXT(I,THCNST),I=1,7)/84,72,67,78,83,84,129/
        DATA (TXT(I,TNAME),I=1,7)/84,78,65,77,69,32,129/
        DATA (TXT(I,TFIELD),I=1,7)/84,70,73,69,76,68,129/
        DATA (TXT(I,TSCALE),I=1,7)/84,83,67,65,76,69,129/
        DATA (TXT(I,TZEOS),I=1,7)/84,90,69,79,83,32,129/
        DATA (TXT(I,TCMMNT),I=1,7)/84,67,77,77,78,84,129/
        DATA (TXT(I,TFMTKD),I=1,7)/84,70,77,84,75,68,129/
        DATA (TXT(I,TENDKD),I=1,7)/84,69,78,68,75,68,129/
        DATA (TXT(I,TERRKD),I=1,7)/84,69,82,82,75,68,129/
 
        IF((TYPE .LE. 0) .OR. (TYPE .GT. TKLAST)) THEN
          CALL REMARK('ZTOKNM: TYPE ARGUMENT OUT OF RANGE')
          TEXT(1) = 129
          ZTOKNM = -1
          RETURN
 
        ELSE
          CALL SCOPY(TXT(1, TYPE), 1, TEXT, 1)
          ZTOKNM = -2
 
        ENDIF
 
        END
C----------------------------------------------------
C
C  INITIALISE TOKEN INPUT.
C
C  TYPE = 0   ERROR, THIS VERSION DOES NOT HAVE A SCANNER.
C  TYPE > 0   INPUT USING TOKEN READ FROM A FILE.
C  TYPE < 0   ERROR.
C
      INTEGER FUNCTION ZTKGTI(TYPE, FD1, FD2)
 
      INTEGER  FD1, FD2, TYPE, I
      LOGICAL  FIRST
 
      INTEGER LIMIT, MAXSET, SIZE, LENT
      PARAMETER (LIMIT = 2, SIZE = 132, LENT = SIZE + 2)
 
      INTEGER FDTOKS(LIMIT), FDCMTS(LIMIT), CMTBUF(LENT, LIMIT),
     +        TKNBUF(LENT, LIMIT), TPOINT(LIMIT), CPOINT(LIMIT),
     +        LSTTKN(LIMIT), INTYP(LIMIT)
      COMMON /XCTKIN/ FDTOKS, FDCMTS, CMTBUF, TKNBUF, TPOINT, CPOINT,
     +        LSTTKN, INTYP, MAXSET
      SAVE
 
      DATA FIRST/.TRUE./
 
      ZTKGTI = -1
      IF(FIRST) THEN
        MAXSET = 0
        FIRST = .FALSE.
        DO 10 I = 1, LIMIT
          INTYP(I) = -100
   10   CONTINUE
      ENDIF
      IF(MAXSET .EQ. LIMIT) RETURN
      IF(TYPE .LE. 0) RETURN
 
      IF(FD1 .GT. 0) CALL SEEK(0, FD1)
      IF(FD2 .GT. 0) CALL SEEK(0, FD2)
 
      MAXSET = MAXSET + 1
      DO 20 I = 1, LIMIT
        IF(INTYP(I) .EQ. -100) THEN
          INTYP(I)  = TYPE
          FDTOKS(I) = FD1
          FDCMTS(I) = FD2
          TPOINT(I) = SIZE + 1
          CPOINT(I) = SIZE + 1
          LSTTKN(I) = 0
 
          ZTKGTI = I
          RETURN
        ENDIF
   20 CONTINUE
 
      END
C----------------------------------------------------
C
C  TERMINATE TOKEN INPUT.
C
      SUBROUTINE ZTKGTQ(CHAN)
 
      INTEGER  CHAN
 
      INTEGER LIMIT, MAXSET, LENT, SIZE
      PARAMETER (LIMIT = 2, SIZE = 132, LENT = SIZE + 2)
 
      INTEGER FDTOKS(LIMIT), FDCMTS(LIMIT), CMTBUF(LENT, LIMIT),
     +        TKNBUF(LENT, LIMIT), TPOINT(LIMIT), CPOINT(LIMIT),
     +        LSTTKN(LIMIT), INTYP(LIMIT)
      COMMON /XCTKIN/ FDTOKS, FDCMTS, CMTBUF, TKNBUF, TPOINT, CPOINT,
     +        LSTTKN, INTYP, MAXSET
 
      SAVE
 
      INTYP(CHAN) = -100
      MAXSET = MAX(MAXSET-1, 0)
 
      END
C----------------------------------------------------
C
C  INITIALISE TOKEN OUTPUT.
C
C  TYPE = 0   ERROR, NO POLISH ATTACHED.
C  TYPE > 0   OUTPUT TO A TOKEN STREAM AND COMMENT FILE PAIR.
C  TYPE < 0   ERROR.
C
      INTEGER FUNCTION ZTKPTI(TYPE, FD1, FD2)
 
      INTEGER  FD1, FD2, TYPE
      LOGICAL  FIRST
 
      INTEGER LIMIT, MAXSET, SIZE, LENT
      PARAMETER (LIMIT = 2, SIZE = 132, LENT = SIZE + 2)
 
      INTEGER FDTOKS(LIMIT), FDCMTS(LIMIT), CMTBUF(LENT, LIMIT),
     +        TKNBUF(LENT, LIMIT), TPOINT(LIMIT), CPOINT(LIMIT),
     +        LSTTKN(LIMIT), OUTTYP(LIMIT)
      COMMON /XCTKOT/ FDTOKS, FDCMTS, CMTBUF, TKNBUF, TPOINT, CPOINT,
     +        LSTTKN, OUTTYP, MAXSET
      SAVE
      INTEGER I
 
      DATA FIRST/.TRUE./
 
      ZTKPTI = -1
      IF(FIRST) THEN
        MAXSET = 0
        FIRST = .FALSE.
        DO 10 I = 1, LIMIT
          OUTTYP(I) = -100
   10   CONTINUE
      ENDIF
      IF(MAXSET .EQ. LIMIT) RETURN
      IF(TYPE .LE. 0) RETURN
 
      IF(FD1 .GT. 0) CALL SEEK(0, FD1)
      IF(FD2 .GT. 0) CALL SEEK(0, FD2)
 
      MAXSET = MAXSET + 1
      DO 20 I = 1, LIMIT
        IF(OUTTYP(I) .EQ. -100) THEN
          OUTTYP(I) = TYPE
          FDTOKS(I) = FD1
          FDCMTS(I) = FD2
          TPOINT(I) = 1
          CPOINT(I) = 1
          LSTTKN(I) = 0
 
          ZTKPTI = I
          RETURN
        ENDIF
   20 CONTINUE
 
      END
C----------------------------------------------------
C
C  TERMINATE TOKEN OUTPUT.
C
      SUBROUTINE ZTKPTQ(CHAN)
 
      INTEGER  CHAN
 
      INTEGER LIMIT, MAXSET, LENT, SIZE
      PARAMETER (LIMIT = 2, SIZE = 132, LENT = SIZE + 2)
 
      INTEGER FDTOKS(LIMIT), FDCMTS(LIMIT), CMTBUF(LENT, LIMIT),
     +        TKNBUF(LENT, LIMIT), TPOINT(LIMIT), CPOINT(LIMIT),
     +        LSTTKN(LIMIT), OUTTYP(LIMIT)
      COMMON /XCTKOT/ FDTOKS, FDCMTS, CMTBUF, TKNBUF, TPOINT, CPOINT,
     +        LSTTKN, OUTTYP, MAXSET
 
      SAVE
 
      OUTTYP(CHAN) = -100
      MAXSET = MAX(MAXSET-1, 0)
 
      END
C----------------------------------------------------
C
C  READ A TOKEN FROM A TOKEN STREAM/COMMENT FILE PAIR THAT
C  HAVE BEEN INITIALISED USING ZTOKIN. THIS ROUTINE IS VERY
C  SIMILAR TO ZTREAD BUT ALLOWS MULTIPLE PAIRS OF FILES
C  TO BE IN USE AT THE SAME TIME.
C
      SUBROUTINE ZGETTK (TYPE, LENGTH, STRING, CNTRL, STATUS)
C
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.1
C---------------------------------------------------------
C
C  TKLAST = LAST TOKEN NUMBER
C
      INTEGER TZEOF ,TASSIG,TBACKS,TBLOCK,TCALL ,TCLOSE,TCOMMO,TCONTI,
     +        TDATA ,TDO   ,TDIMEN,TELSE ,TELSIF,TEND  ,TENDFI,TENDIF,
     +        TENTRY,TEQUIV,TEXTER,TFUNCT,TFORMA,TGOTO ,TIF   ,TIMPLI,
     +        TINQUI,TINTRI,TOPEN ,TPARAM,TPAUSE,TPRINT,TPROGR,TREAD ,
     +        TRETUR,TREWIN,TSAVE ,TSTOP ,TSUBRO,TTHEN ,TTO   ,TWRITE,
     +        TINTEG,TREAL ,TDOUBL,TCOMPL,TLOGIC,TCHARA,TDCMPL,TCOMMA,
     +        TEQUAL,TCOLON,TLPARN,TRPARN,TLE   ,TLT   ,TEQ   ,TNE   ,
     +        TGE   ,TGT   ,TAND  ,TOR   ,TEQV  ,TNEQV ,TNOT  ,TSTAR ,
     +        TDSTAR,TPLUS ,TMINUS,TSLASH,TCNCAT,TDCNST,TLCNST,TRCNST,
     +        TPCNST,TCCNST,THCNST,TNAME ,TFIELD,TSCALE,TZEOS ,TCMMNT,
     +        TFMTKD,TENDKD,TERRKD,TKLAST
      PARAMETER (TZEOF = 1,TASSIG= 2,TBACKS= 3,TBLOCK= 4,TCALL = 5,
     +           TCLOSE= 6,TCOMMO= 7,TCONTI= 8,TDATA = 9,TDO   =10,
     +           TDIMEN=11,TELSE =12,TELSIF=13,TEND  =14,TENDFI=15,
     +           TENDIF=16,TENTRY=17,TEQUIV=18,TEXTER=19,TFUNCT=20,
     +           TFORMA=21,TGOTO =22,TIF   =23,TIMPLI=24,TINQUI=25,
     +           TINTRI=26,TOPEN =27,TPARAM=28,TPAUSE=29,TPRINT=30,
     +           TPROGR=31,TREAD =32,TRETUR=33,TREWIN=34,TSAVE =35,
     +           TSTOP =36,TSUBRO=37,TTHEN =38,TTO   =39,TWRITE=40,
     +           TINTEG=41,TREAL =42,TDOUBL=43,TCOMPL=44,TLOGIC=45,
     +           TCHARA=46,TDCMPL=47,TCOMMA=48,TEQUAL=49,TCOLON=50,
     +           TLPARN=51,TRPARN=52,TLE   =53,TLT   =54,TEQ   =55,
     +           TNE   =56,TGE   =57,TGT   =58,TAND  =59,TOR   =60,
     +           TEQV  =61,TNEQV =62,TNOT  =63,TSTAR =64,TDSTAR=65,
     +           TPLUS =66,TMINUS=67,TSLASH=68,TCNCAT=69,TDCNST=70,
     +           TLCNST=71,TRCNST=72,TPCNST=73,TCCNST=74,THCNST=75,
     +           TNAME =76,TFIELD=77,TSCALE=78,TZEOS =79,TCMMNT=80,
     +           TFMTKD=81,TENDKD=82,TERRKD=83,TKLAST=83)
 
      INTEGER TYPE, CNTRL, FIRST, SECOND, C, LENGTH,
     +        I, STATUS
      INTEGER STRING (*)
 
      INTEGER LIMIT, MAXSET, SIZE, LENT
      PARAMETER (LIMIT = 2, SIZE = 132, LENT = SIZE + 2)
 
      INTEGER FDTOKS(LIMIT), FDCMTS(LIMIT), CMTBUF(LENT, LIMIT),
     +        TKNBUF(LENT, LIMIT), TPOINT(LIMIT), CPOINT(LIMIT),
     +        LSTTKN(LIMIT), INTYP(LIMIT)
      COMMON /XCTKIN/ FDTOKS, FDCMTS, CMTBUF, TKNBUF, TPOINT, CPOINT,
     +        LSTTKN, INTYP, MAXSET
      SAVE
C
C  CHECK THE LEGALITY OF THE REQUEST
C
      IF(CNTRL .LE. 0 .OR. CNTRL .GT. MAXSET) THEN
        CALL REMARK('ZGETTK: CNTRL ARGUMENT OUT OF RANGE')
        STATUS = -1
        RETURN
      ELSE IF(INTYP(CNTRL) .LE. 0) THEN
        CALL REMARK('ZGETTK: CNTRL ARGUMENT NAMES AN INACTIVE STREAM')
        STATUS = -1
        RETURN
      ENDIF
 
    5 CONTINUE
      IF(LSTTKN(CNTRL) .EQ. TCMMNT) THEN
        CALL XTKSUB(FIRST, CPOINT(CNTRL), CMTBUF(1,CNTRL),
     +              SIZE, FDCMTS(CNTRL), STATUS)
        IF(STATUS .NE. -2) RETURN
        CALL XTKSUB(SECOND, CPOINT(CNTRL), CMTBUF(1,CNTRL),
     +              SIZE, FDCMTS(CNTRL), STATUS)
        IF(STATUS .NE. -2) RETURN
 
        LENGTH = (FIRST-48)*10 + SECOND - 48
        DO 10 I = 1, LENGTH
          CALL XTKSUB(C,  CPOINT(CNTRL), CMTBUF(1,CNTRL),
     +              SIZE, FDCMTS(CNTRL), STATUS)
          IF(STATUS .NE. -2) RETURN
          STRING(I) = C
   10   CONTINUE
        STRING(I) = 129
        TYPE = TCMMNT
        IF(LENGTH .NE. 1) RETURN
        IF(STRING(1) .NE. 36) RETURN
 
      ENDIF
 
      CALL XTKSUB(FIRST,  TPOINT(CNTRL), TKNBUF(1,CNTRL),
     +              SIZE, FDTOKS(CNTRL), STATUS)
      IF(STATUS .NE. -2) RETURN
      CALL XTKSUB(SECOND,  TPOINT(CNTRL), TKNBUF(1,CNTRL),
     +              SIZE, FDTOKS(CNTRL), STATUS)
      IF(STATUS .NE. -2) RETURN
 
      TYPE = (FIRST-48)*10 + SECOND - 48
      IF(TYPE .EQ. TCMMNT) THEN
        LSTTKN(CNTRL) = TCMMNT
        GO TO 5
      ENDIF
 
      LENGTH = 0
      DO 20 I = 1, 5
        CALL XTKSUB(FIRST, TPOINT(CNTRL), TKNBUF(1,CNTRL),
     +              SIZE, FDTOKS(CNTRL), STATUS)
        IF(STATUS .NE. -2) RETURN
        IF(FIRST .EQ. 32) GO TO 22
        LENGTH = 10*LENGTH + FIRST-48
   20 CONTINUE
 
   22 CONTINUE
      DO 30 I = 1, LENGTH
        CALL XTKSUB(C, TPOINT(CNTRL), TKNBUF(1,CNTRL),
     +              SIZE, FDTOKS(CNTRL), STATUS)
        IF(STATUS .NE. -2) RETURN
        STRING(I) = C
   30 CONTINUE
      STRING(I) = 129
 
      LSTTKN(CNTRL) = TYPE
 
      END
C----------------------------------------------------------
C
C  DUMMY VERSION OF INPUT ROUTINE.
C
      SUBROUTINE ZSCAN(TKNTYP, TKNLEN, TKNSTR, DESC, STATUS)
 
      INTEGER TKNTYP, TKNLEN, TKNSTR(*), DESC, STATUS
 
      STATUS = -1
 
      END
C----------------------------------------------------
C
      SUBROUTINE ZPUTTK(TYPE, LENGTH, STRING, CNTRL)
 
      INTEGER TYPE, LENGTH, CNTRL, I, FIRST, SECOND, THIRD,
     +        FOURTH, ACTLEN
      INTEGER STRING(*)
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.1
C---------------------------------------------------------
C
C  TKLAST = LAST TOKEN NUMBER
C
      INTEGER TZEOF ,TASSIG,TBACKS,TBLOCK,TCALL ,TCLOSE,TCOMMO,TCONTI,
     +        TDATA ,TDO   ,TDIMEN,TELSE ,TELSIF,TEND  ,TENDFI,TENDIF,
     +        TENTRY,TEQUIV,TEXTER,TFUNCT,TFORMA,TGOTO ,TIF   ,TIMPLI,
     +        TINQUI,TINTRI,TOPEN ,TPARAM,TPAUSE,TPRINT,TPROGR,TREAD ,
     +        TRETUR,TREWIN,TSAVE ,TSTOP ,TSUBRO,TTHEN ,TTO   ,TWRITE,
     +        TINTEG,TREAL ,TDOUBL,TCOMPL,TLOGIC,TCHARA,TDCMPL,TCOMMA,
     +        TEQUAL,TCOLON,TLPARN,TRPARN,TLE   ,TLT   ,TEQ   ,TNE   ,
     +        TGE   ,TGT   ,TAND  ,TOR   ,TEQV  ,TNEQV ,TNOT  ,TSTAR ,
     +        TDSTAR,TPLUS ,TMINUS,TSLASH,TCNCAT,TDCNST,TLCNST,TRCNST,
     +        TPCNST,TCCNST,THCNST,TNAME ,TFIELD,TSCALE,TZEOS ,TCMMNT,
     +        TFMTKD,TENDKD,TERRKD,TKLAST
      PARAMETER (TZEOF = 1,TASSIG= 2,TBACKS= 3,TBLOCK= 4,TCALL = 5,
     +           TCLOSE= 6,TCOMMO= 7,TCONTI= 8,TDATA = 9,TDO   =10,
     +           TDIMEN=11,TELSE =12,TELSIF=13,TEND  =14,TENDFI=15,
     +           TENDIF=16,TENTRY=17,TEQUIV=18,TEXTER=19,TFUNCT=20,
     +           TFORMA=21,TGOTO =22,TIF   =23,TIMPLI=24,TINQUI=25,
     +           TINTRI=26,TOPEN =27,TPARAM=28,TPAUSE=29,TPRINT=30,
     +           TPROGR=31,TREAD =32,TRETUR=33,TREWIN=34,TSAVE =35,
     +           TSTOP =36,TSUBRO=37,TTHEN =38,TTO   =39,TWRITE=40,
     +           TINTEG=41,TREAL =42,TDOUBL=43,TCOMPL=44,TLOGIC=45,
     +           TCHARA=46,TDCMPL=47,TCOMMA=48,TEQUAL=49,TCOLON=50,
     +           TLPARN=51,TRPARN=52,TLE   =53,TLT   =54,TEQ   =55,
     +           TNE   =56,TGE   =57,TGT   =58,TAND  =59,TOR   =60,
     +           TEQV  =61,TNEQV =62,TNOT  =63,TSTAR =64,TDSTAR=65,
     +           TPLUS =66,TMINUS=67,TSLASH=68,TCNCAT=69,TDCNST=70,
     +           TLCNST=71,TRCNST=72,TPCNST=73,TCCNST=74,THCNST=75,
     +           TNAME =76,TFIELD=77,TSCALE=78,TZEOS =79,TCMMNT=80,
     +           TFMTKD=81,TENDKD=82,TERRKD=83,TKLAST=83)
 
 
      INTEGER LIMIT, MAXSET, SIZE, LENT
      PARAMETER (LIMIT = 2, SIZE = 132, LENT = SIZE + 2)
 
      INTEGER FDTOKS(LIMIT), FDCMTS(LIMIT), CMTBUF(LENT, LIMIT),
     +        TKNBUF(LENT, LIMIT), TPOINT(LIMIT), CPOINT(LIMIT),
     +        LSTTKN(LIMIT), OUTTYP(LIMIT)
      COMMON /XCTKOT/ FDTOKS, FDCMTS, CMTBUF, TKNBUF, TPOINT, CPOINT,
     +        LSTTKN, OUTTYP, MAXSET
      SAVE
 
 
      IF(CNTRL .LE. 0 .OR. CNTRL .GT. MAXSET) RETURN
      IF(OUTTYP(CNTRL) .LE. 0) RETURN
 
      IF(TYPE .EQ. TCMMNT) THEN
        IF(LSTTKN(CNTRL) .NE. TCMMNT) THEN
          FIRST  = TYPE/10
          SECOND = TYPE - (FIRST*10) + 48
          FIRST  = FIRST + 48
          CALL XTKADD(FIRST, TPOINT(CNTRL), TKNBUF(1,CNTRL),
     +                SIZE, FDTOKS(CNTRL))
          CALL XTKADD(SECOND, TPOINT(CNTRL), TKNBUF(1,CNTRL),
     +                SIZE, FDTOKS(CNTRL))
        ENDIF
        ACTLEN = LENGTH
    5   IF(STRING(ACTLEN) .EQ. 32) THEN
          ACTLEN = ACTLEN - 1
          IF(ACTLEN .GT. 0) GO TO 5
        ENDIF
        IF(ACTLEN .EQ. 0) THEN
          CALL XTKADD(48, CPOINT(CNTRL), CMTBUF(1,CNTRL),
     +                SIZE, FDCMTS(CNTRL))
          CALL XTKADD(48, CPOINT(CNTRL), CMTBUF(1,CNTRL),
     +                SIZE, FDCMTS(CNTRL))
        ELSE
          FIRST  = ACTLEN/10
          SECOND = ACTLEN - (FIRST*10) + 48
          FIRST  = FIRST + 48
          CALL XTKADD(FIRST, CPOINT(CNTRL), CMTBUF(1,CNTRL),
     +                SIZE, FDCMTS(CNTRL))
          CALL XTKADD(SECOND, CPOINT(CNTRL), CMTBUF(1,CNTRL),
     +                SIZE, FDCMTS(CNTRL))
          DO 10 I = 1, ACTLEN
            CALL XTKADD(STRING(I), CPOINT(CNTRL), CMTBUF(1,CNTRL),
     +                SIZE, FDCMTS(CNTRL))
   10     CONTINUE
        ENDIF
 
      ELSE
        IF(LSTTKN(CNTRL) .EQ. TCMMNT) THEN
          CALL XTKADD(48, CPOINT(CNTRL), CMTBUF(1,CNTRL),
     +                SIZE, FDCMTS(CNTRL))
          CALL XTKADD(49, CPOINT(CNTRL), CMTBUF(1,CNTRL),
     +                SIZE, FDCMTS(CNTRL))
          CALL XTKADD(36, CPOINT(CNTRL), CMTBUF(1,CNTRL),
     +                SIZE, FDCMTS(CNTRL))
        ENDIF
        FIRST  = TYPE/10
        SECOND = TYPE - (FIRST*10) + 48
        FIRST  = FIRST + 48
        CALL XTKADD(FIRST, TPOINT(CNTRL), TKNBUF(1,CNTRL),
     +              SIZE, FDTOKS(CNTRL))
        CALL XTKADD(SECOND, TPOINT(CNTRL), TKNBUF(1,CNTRL),
     +              SIZE, FDTOKS(CNTRL))
 
        FIRST  =  LENGTH/1000
        SECOND = (LENGTH - (FIRST*1000))/100
        THIRD  = (LENGTH - (FIRST*1000) - (SECOND*100))/10
        FOURTH =  LENGTH - (FIRST*1000) - (SECOND*100) - (THIRD*10)
        FIRST  = FIRST + 48
        SECOND = SECOND + 48
        THIRD  = THIRD + 48
        FOURTH = FOURTH + 48
        IF(FIRST .NE. 48) THEN
          CALL XTKADD(FIRST , TPOINT(CNTRL), TKNBUF(1,CNTRL),
     +                SIZE, FDTOKS(CNTRL))
          CALL XTKADD(SECOND, TPOINT(CNTRL), TKNBUF(1,CNTRL),
     +                SIZE, FDTOKS(CNTRL))
          CALL XTKADD(THIRD,  TPOINT(CNTRL), TKNBUF(1,CNTRL),
     +                SIZE, FDTOKS(CNTRL))
          CALL XTKADD(FOURTH, TPOINT(CNTRL), TKNBUF(1,CNTRL),
     +                SIZE, FDTOKS(CNTRL))
        ELSE IF(SECOND .NE. 48) THEN
          CALL XTKADD(SECOND, TPOINT(CNTRL), TKNBUF(1,CNTRL),
     +                SIZE, FDTOKS(CNTRL))
          CALL XTKADD(THIRD,  TPOINT(CNTRL), TKNBUF(1,CNTRL),
     +                SIZE, FDTOKS(CNTRL))
          CALL XTKADD(FOURTH, TPOINT(CNTRL), TKNBUF(1,CNTRL),
     +                SIZE, FDTOKS(CNTRL))
        ELSE IF(THIRD .NE. 48) THEN
          CALL XTKADD(THIRD,  TPOINT(CNTRL), TKNBUF(1,CNTRL),
     +                SIZE, FDTOKS(CNTRL))
          CALL XTKADD(FOURTH, TPOINT(CNTRL), TKNBUF(1,CNTRL),
     +                SIZE, FDTOKS(CNTRL))
        ELSE IF(FOURTH .NE. 48) THEN
          CALL XTKADD(FOURTH, TPOINT(CNTRL), TKNBUF(1,CNTRL),
     +                SIZE, FDTOKS(CNTRL))
        ENDIF
        CALL XTKADD(32, TPOINT(CNTRL), TKNBUF(1,CNTRL),
     +                SIZE, FDTOKS(CNTRL))
        DO 20 I = 1, LENGTH
          CALL XTKADD(STRING(I), TPOINT(CNTRL), TKNBUF(1,CNTRL),
     +                SIZE, FDTOKS(CNTRL))
   20   CONTINUE
 
        IF(TYPE .EQ. TZEOF) THEN
          I = TPOINT(CNTRL)
          CALL XTKADD(32,TPOINT(CNTRL),TKNBUF(1,CNTRL),I,FDTOKS(CNTRL))
          I = CPOINT(CNTRL)
          CALL XTKADD(32,CPOINT(CNTRL),CMTBUF(1,CNTRL),I,FDCMTS(CNTRL))
        ENDIF
 
      ENDIF
 
      LSTTKN(CNTRL) = TYPE
 
      END
C----------------------------------------------------------
C
C  DUMMY VERSION OF OUTPUT ROUTINE.
C
      SUBROUTINE ZUSCAN(TKNTYP, TKNLEN, TKNSTR, DESC)
 
      INTEGER TKNTYP, TKNLEN, TKNSTR(*), DESC
 
      END
C----------------------------------------------------
C
      SUBROUTINE XTKADD(CHAR, POINT, BUFF, LIMIT, FD)
 
      INTEGER CHAR, POINT, LIMIT, FD, I
      INTEGER BUFF(*)
 
      IF(FD .EQ. -1) RETURN
      BUFF(POINT) = CHAR
      POINT = POINT + 1
      IF(POINT .GT. LIMIT) THEN
        POINT = 1
        DO 10 I = 1, LIMIT
          CALL PUTCH(BUFF(I), FD)
   10   CONTINUE
        CALL PUTCH(10, FD)
      ENDIF
 
      END
C----------------------------------------------------
C
      SUBROUTINE XTKSUB(CHAR, POINT, BUFF, LIMIT, FD, STATUS)
 
      INTEGER CHAR, POINT, LIMIT, FD, I, STATUS
      INTEGER BUFF(*)
      INTEGER ZGTCMD
 
      IF(POINT .GT. LIMIT) THEN
        POINT = 1
        STATUS = ZGTCMD(BUFF, FD)
        IF(STATUS .EQ. -1) RETURN
        IF(STATUS .EQ. -100) RETURN
        DO 10 I = STATUS + 1, LIMIT
          BUFF(I) = 32
   10   CONTINUE
      ENDIF
 
      STATUS = -2
      CHAR = BUFF(POINT)
      POINT = POINT + 1
 
      END
